home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
os2
/
lopbk505.zip
/
LBKMOD6.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1997-03-25
|
17KB
|
1,207 lines
;------------------------------------------------------------------------------
; .ss.
; `²²'
; .,sS$Ss,,s$ .,sS$$$Ss. .,sS$Ss,,s$ .ss. .sSs.
; .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
; $$$' .$$$' $$$²Sçsµ²' .$$$' .$$$'.$$$' .$$$' `$$b.
; $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$' ;$$$
; `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
; .sS²°$$$²²°"' d²°'
; .$$² .$$'
; $$$.,d$$'
; `²S$$S²'
;------------------------------------------------------------------------------
; P.P.L.X. 2.OO (C)1996 - Lone Runner / AEGiS CoRP'96
;------------------------------------------------------------------------------
; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Boolean BOOLEAN002
Boolean BOOLEAN003
Boolean BOOLEAN004
Boolean BOOLEAN005
Boolean BOOLEAN006
Boolean BOOLEAN007
Boolean BOOLEAN008
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Integer INTEGER004
Real REAL001
Real REAL002
Real REAL003
String STRING001
String STRING002
String STRING003
String STRING004
Byte BYTE001
Byte BYTE002
Byte BYTE003
Byte BYTE004
Byte BYTE005
Word WORD001
;------------------------------------------------------------------------------
If (TokCount() <> 1) Then
PrintLn
PrintLn "@X0CLBKMOD6 FATAL ERROR: INVALID COMMAND SEQUENCE!"
PrintLn
PrintLn "@X0APlease run LBKMOD6 from within LoopUtil..."
PrintLn
Goto LABEL039
Else
GetToken STRING001
Select Case (STRING001)
Case "1"
BOOLEAN004 = 1
BOOLEAN007 = 0
BOOLEAN008 = 0
Case "2"
BOOLEAN004 = 0
BOOLEAN007 = 0
BOOLEAN008 = 0
Case "3"
BOOLEAN004 = 0
BOOLEAN007 = 1
BOOLEAN008 = 0
Case "4"
BOOLEAN004 = 0
BOOLEAN007 = 0
BOOLEAN008 = 1
Case Else
PrintLn
PrintLn "@X0CLBKMOD6 FATAL ERROR: INVALID COMMAND SEQUENCE!"
PrintLn
PrintLn "@X0APlease run LBKMOD6 from within LoopUtil..."
PrintLn
Endif
End Select
BOOLEAN005 = 0
:LABEL001
If (BOOLEAN005) Goto LABEL003
PrintLn
PrintLn Space(20) + "@X0FName & Security Trashfile Maintenance MODULE"
PrintLn
PrintLn " @X0F(@X09N@X0F)@X0Bame trashfile"
PrintLn " @X0F(@X09S@X0F)@X0Becurity trashfile"
PrintLn " @X0F(@X09Q@X0F)@X0Buit"
PrintLn
STRING001 = "N"
InputStr "Trashfile maintenance command", STRING001, 14, 1, "NnSsQqRr", 2 + 4
Newline
STRING001 = Upper(STRING001)
Select Case (STRING001)
Case "Q", "R"
BOOLEAN005 = 1
Goto LABEL039
Case "N"
If ((BOOLEAN004 && !BOOLEAN007) && !BOOLEAN008) Then
Gosub LABEL019
ElseIf ((!BOOLEAN004 && !BOOLEAN007) && !BOOLEAN008) Then
Gosub LABEL025
ElseIf ((!BOOLEAN004 && !BOOLEAN007) && BOOLEAN008) Then
Gosub LABEL003
Else
Gosub LABEL007
Endif
BOOLEAN005 = 0
Case "S"
If ((BOOLEAN004 && !BOOLEAN007) && !BOOLEAN008) Then
Gosub LABEL022
Goto LABEL002
Endif
If ((!BOOLEAN004 && !BOOLEAN007) && !BOOLEAN008) Then
Gosub LABEL029
Goto LABEL002
Endif
If ((!BOOLEAN004 && !BOOLEAN007) && BOOLEAN008) Then
Gosub LABEL005
Goto LABEL002
Endif
Gosub LABEL013
:LABEL002
BOOLEAN005 = 0
End Select
Goto LABEL001
:LABEL003
Gosub LABEL033
FSeek 2, 434, 0
FRead 2, STRING002, 75
FClose 2
STRING004 = PPEPath() + "USERNAME.XPT"
InputStr "Path & Filename to export to", STRING004, 15, 45, Mask_Path() + Mask_File(), 2 + 4 + 256
STRING004 = Strip(Upper(STRING004), " ")
If (STRING004 == "") Goto LABEL039
STRING002 = Trim(Upper(STRING002), " ")
If (Exist(STRING002)) Goto LABEL004
PrintLn
PrintLn "@X0C" + STRING002 + " does not exist!"
PrintLn
Delay 4
Goto LABEL039
:LABEL004
INTEGER003 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER003 - 39) / 28
If (Exist(STRING004)) Then
FAppend 1, STRING004, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING004 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
Else
FCreate 1, STRING004, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING004 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
Endif
FOpen 2, STRING002, 0, 0
If (Ferr(2)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
INTEGER001 = 1
Cls
PrintLn
PrintLn Space(15) + "@X0A(@X0FUsername Trash File Exportation Procedure@X0A)"
PrintLn
PrintLn
PrintLn "@X0BFrom :@X0E " + STRING002
PrintLn "@X0BTo :@X0E " + STRING004
PrintLn
Print "@X0CPlease wait, now exporting...@X0F "
FSeek 2, 39, 0
While (INTEGER001 <= INTEGER002) Do
FSeek 2, 3, 1
FRead 2, STRING003, 25
STRING003 = Trim(STRING003, " ")
FPutLn 1, STRING003
Gosub LABEL037
Inc INTEGER001
EndWhile
FClose 1
FClose 2
PrintLn
PrintLn "@X0BExporting process completed!"
Log "Username Trash file exported...", 0
Delay 4
STRING001 = "N"
Return
:LABEL005
Gosub LABEL033
FSeek 2, 959, 0
FRead 2, STRING002, 75
FClose 2
STRING004 = PPEPath() + "USERSEC.XPT"
InputStr "Path & Filename to export to", STRING004, 15, 45, Mask_Path() + Mask_File(), 2 + 4 + 256
STRING004 = Strip(Upper(STRING004), " ")
If (STRING004 == "") Goto LABEL039
STRING002 = Trim(Upper(STRING002), " ")
If (Exist(STRING002)) Goto LABEL006
PrintLn
PrintLn "@X0C" + STRING002 + " does not exist!"
PrintLn
Delay 4
Goto LABEL039
:LABEL006
INTEGER003 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER003 - 39) / 4
If (Exist(STRING004)) Then
FAppend 1, STRING004, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING004 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
Else
FCreate 1, STRING004, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING004 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
Endif
FOpen 2, STRING002, 0, 0
If (Ferr(2)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
INTEGER001 = 1
Cls
PrintLn
PrintLn Space(15) + "@X0A(@X0FSecurity Trash File Exportation Procedure@X0A)"
PrintLn
PrintLn
PrintLn "@X0BFrom :@X0E " + STRING002
PrintLn "@X0BTo :@X0E " + STRING004
PrintLn
Print "@X0CPlease wait, now exporting...@X0F "
FSeek 2, 39, 0
While (INTEGER001 <= INTEGER002) Do
FSeek 2, 3, 1
FRead 2, BYTE001, 1
FPutLn 1, String(BYTE001)
Gosub LABEL037
Inc INTEGER001
EndWhile
FClose 1
FClose 2
PrintLn
PrintLn "@X0BExporting process completed!"
Log "Security Trash file exported...", 0
Delay 4
STRING001 = "S"
Return
:LABEL007
Gosub LABEL033
FSeek 2, 434, 0
FRead 2, STRING002, 75
FClose 2
STRING002 = Upper(STRING002)
STRING004 = ""
PrintLn
InputStr "Path & filename to import", STRING004, 15, 45, Mask_Path() + Mask_File(), 2 + 4
Newline
STRING004 = Trim(Upper(STRING004), " ")
If (STRING004 == "") Return
WORD001 = 0
InputInt "Default node affected to place in all imported records", WORD001, 15
Newline
If (Exist(STRING004)) Goto LABEL008
PrintLn
PrintLn "@X0C" + STRING004 + " does not exist!"
PrintLn
Delay 9
Goto LABEL039
:LABEL008
If (Exist(STRING002)) Goto LABEL009
FCreate 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack 5.05 Username Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
Goto LABEL010
:LABEL009
FOpen 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 2
:LABEL010
FOpen 2, STRING004, 0, 0
If (Ferr(2)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING004 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
Cls
PrintLn
PrintLn Space(13) + "@X0A(@X0FUsername Trash File Text File Importation Procedure@X0A)"
PrintLn
PrintLn "@X0BFrom :@X0E " + STRING004
PrintLn "@X0BTo :@X0E " + STRING002
PrintLn "@X0BDefault Node :@X0E " + String(WORD001)
PrintLn
PrintLn
Print "@X0AImporting record #@X0F1"
INTEGER001 = 1
INTEGER004 = 1
:LABEL011
If (Ferr(2)) Goto LABEL012
Backup Len(String(INTEGER004))
Print String(INTEGER001)
STRING001 = ""
FGet 2, STRING001
STRING001 = Trim(Trim(Trim(STRING001, " "), Chr(13)), Chr(10))
If (STRING001 <> "") Then
FWrite 1, 0, 1
FWrite 1, WORD001, 2
FWrite 1, STRING001, 25
INTEGER004 = INTEGER001
Inc INTEGER001
Endif
Goto LABEL011
:LABEL012
STRING001 = "N"
FClose 1
FClose 2
PrintLn
PrintLn "Username trash file importation process successful!"
Log STRING004 + "imported in Username trash file", 0
Return
:LABEL013
Gosub LABEL033
FSeek 2, 959, 0
FRead 2, STRING002, 75
FClose 2
STRING002 = Upper(STRING002)
STRING004 = ""
PrintLn
InputStr "Path & filename to import", STRING004, 15, 45, Mask_Path() + Mask_File(), 2 + 4
Newline
STRING004 = Trim(Upper(STRING004), " ")
If (STRING004 == "") Return
InputInt "Default node affected to place in all imported records", WORD001, 15
Newline
If (Exist(STRING004)) Goto LABEL014
PrintLn
PrintLn "@X0C" + STRING004 + " does not exist!"
PrintLn
Delay 9
Goto LABEL039
:LABEL014
If (Exist(STRING002)) Goto LABEL015
FCreate 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack 5.05 Username Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
Goto LABEL016
:LABEL015
FOpen 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 2
:LABEL016
FOpen 2, STRING004, 0, 0
If (Ferr(2)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING004 + " @X0Cfile is currently inaccessible..."
FClose 1
FClose 2
Return
Endif
Cls
PrintLn
PrintLn Space(13) + "@X0A(@X0FSecurity Trash File Text File Importation Procedure@X0A)"
PrintLn
PrintLn "@X0BFrom :@X0E " + STRING004
PrintLn "@X0BTo :@X0E " + STRING002
PrintLn "@X0BDefault Node :@X0E " + String(WORD001)
PrintLn
PrintLn
Print "@X0AImporting record #@X0F1"
INTEGER001 = 1
INTEGER004 = 1
:LABEL017
If (Ferr(2)) Goto LABEL018
Backup Len(String(INTEGER004))
Print String(INTEGER001)
FGet 2, STRING001
BYTE001 = S2I(STRING001, 10)
If (STRING001 <> "") Then
FWrite 1, 0, 1
FWrite 1, WORD001, 2
FWrite 1, BYTE001, 1
INTEGER004 = INTEGER001
Inc INTEGER001
Endif
Goto LABEL017
:LABEL018
STRING001 = "S"
FClose 1
FClose 2
PrintLn
PrintLn "Security trash file importation process successful!"
Log STRING004 + "imported in Security trash file", 0
Return
:LABEL019
Gosub LABEL033
FSeek 2, 434, 0
FRead 2, STRING002, 75
FClose 2
If (Exist(STRING002)) Goto LABEL020
PrintLn
PrintLn "@X0C" + STRING002 + " does not exist!"
Delay 9
Return
:LABEL020
INTEGER003 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER003 - 39) / 28
PrintLn
PrintLn "@X0F FileSize = " + String(INTEGER003) + " NumRecs = " + String(INTEGER002)
If (INTEGER002 <= 1) Then
PrintLn
PrintLn "@X0CTHERE MUST BE AT LEAST ONE RECORD PRESENT IN THE TRASH CAN FILE!"
PrintLn
Delay 18
Return
Endif
KbdChkOff
Rename STRING002, PPEPath() + String(PcbNode()) + "tn.$$$"
FCreate 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FOpen 2, PPEPath() + String(PcbNode()) + "tn.$$$", 0, 3
If (Ferr(2)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + String(PcbNode()) + "tn.$$$ @X0Cfile is currently inaccessible..."
FClose 2
FClose 1
PrintLn
PrintLn "@X0ADeleting & renaming temporary files..."
Delete STRING002
Rename PPEPath() + String(PcbNode()) + "tn.$$$", STRING002
Return
Endif
BOOLEAN002 = 0
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 Username Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
PrintLn
Print "@X0BPacking Name Trash Can File... "
If (OnLocal()) Then
PrintLn
PrintLn
Print "@X0F0% @X07░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ @X0F100%"
BYTE002 = GetY()
Endif
INTEGER003 = FileInf(PPEPath() + String(PcbNode()) + "tn.$$$", 4)
INTEGER002 = (INTEGER003 - 39) / 28
INTEGER001 = 1
While (INTEGER001 <= INTEGER002) Do
BOOLEAN002 = 0
BOOLEAN006 = 0
WORD001 = 0
STRING003 = ""
FSeek 2, 39 + INTEGER001 * 28 - 28, 0
FRead 2, BOOLEAN006, 1
If (BOOLEAN006) Then
BOOLEAN002 = 1
Else
BOOLEAN002 = 0
Endif
If (BOOLEAN002) Goto LABEL021
FWrite 1, BOOLEAN006, 1
FRead 2, WORD001, 2
FWrite 1, WORD001, 2
FRead 2, STRING003, 25
FWrite 1, STRING003, 25
:LABEL021
If (OnLocal()) Then
Gosub LABEL036
Else
Gosub LABEL037
Endif
Inc INTEGER001
EndWhile
Color 7
FClose 1
FClose 2
PrintLn
PrintLn
PrintLn "@X0BDeleting temporary files..."
Delete PPEPath() + String(PcbNode()) + "tn.$$$"
PrintLn "@X0EChecking files..."
INTEGER003 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER003 - 39) / 28
If (INTEGER002 < 1) Then
PrintLn
PrintLn "@X0C0 byte file! Recreating with a dummy record..."
FCreate 1, STRING002, 1, 2
FWrite 1, " LoopBack 5.05 Username Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
FWrite 1, 0, 1
FWrite 1, 0, 2
FWrite 1, Space(25), 25
FClose 1
PrintLn "@X0ANew name trash can file successfully created..."
Endif
PrintLn "@X0FName trash can file successfully packed!"
Log "Name trash can file successfully packed!", 0
KbdChkOn
Return
:LABEL022
Gosub LABEL033
FSeek 2, 959, 0
FRead 2, STRING002, 75
FClose 2
If (Exist(STRING002)) Goto LABEL023
PrintLn
PrintLn "@X0C" + STRING002 + " does not exist!"
Delay 9
Return
:LABEL023
INTEGER003 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER003 - 39) / 4
PrintLn
PrintLn "@X0F FileSize = " + String(INTEGER003) + " NumRecs = " + String(INTEGER002)
If (INTEGER002 <= 1) Then
PrintLn
PrintLn "@X0CTHERE MUST BE AT LEAST ONE RECORD PRESENT IN THE TRASH CAN FILE!"
PrintLn
Delay 18
Return
Endif
KbdChkOff
Rename STRING002, PPEPath() + String(PcbNode()) + "tl.$$$"
FCreate 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FOpen 2, PPEPath() + String(PcbNode()) + "tl.$$$", 0, 3
If (Ferr(2)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + String(PcbNode()) + "tl.$$$ @X0Cfile is currently inaccessible..."
FClose 2
FClose 1
PrintLn
PrintLn "@X0ADeleting & renaming temporary files..."
Delete STRING002
Rename PPEPath() + String(PcbNode()) + "tl.$$$", STRING002
Return
Endif
BOOLEAN002 = 0
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 Security Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
PrintLn
Print "@X0BPacking Security Trash Can File... "
If (OnLocal()) Then
PrintLn
PrintLn
Print "@X0F0% @X07░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ @X0F100%"
BYTE002 = GetY()
Endif
INTEGER003 = FileInf(PPEPath() + String(PcbNode()) + "tl.$$$", 4)
INTEGER002 = (INTEGER003 - 39) / 4
INTEGER001 = 1
While (INTEGER001 <= INTEGER002) Do
BOOLEAN002 = 0
BOOLEAN006 = 0
WORD001 = 0
BYTE001 = 0
FSeek 2, 39 + INTEGER001 * 4 - 4, 0
FRead 2, BOOLEAN006, 1
If (BOOLEAN006) Then
BOOLEAN002 = 1
Else
BOOLEAN002 = 0
Endif
If (BOOLEAN002) Goto LABEL024
FWrite 1, BOOLEAN006, 1
FRead 2, WORD001, 2
FWrite 1, WORD001, 2
FRead 2, BYTE001, 1
FWrite 1, BYTE001, 1
:LABEL024
If (OnLocal()) Then
Gosub LABEL036
Else
Gosub LABEL037
Endif
Inc INTEGER001
EndWhile
Color 7
FClose 1
FClose 2
PrintLn
PrintLn
PrintLn "@X0BDeleting temporary files..."
Delete PPEPath() + String(PcbNode()) + "tl.$$$"
PrintLn "@X0EChecking files..."
INTEGER003 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER003 - 39) / 4
If (INTEGER002 < 1) Then
PrintLn
PrintLn "@X0C0 byte file! Recreating with a dummy record..."
FCreate 1, STRING002, 1, 2
FWrite 1, " LoopBack 5.05 Security Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
FWrite 1, 0, 1
FWrite 1, 0, 2
FWrite 1, 0, 1
FClose 1
PrintLn "@X0ANew security trash can file successfully created..."
Endif
PrintLn "@X0FName security can file successfully packed!"
Log "Security trash can file successfully packed!", 0
KbdChkOn
Return
:LABEL025
BOOLEAN002 = 0
BOOLEAN001 = 1
INTEGER001 = 1
Gosub LABEL033
FSeek 2, 434, 0
FRead 2, STRING002, 75
FClose 2
INTEGER003 = FileInf(STRING002, 4)
If (Exist(STRING002)) Goto LABEL026
PrintLn
PrintLn "@X0CCreating " + STRING002
BOOLEAN003 = 1
FCreate 1, STRING002, 2, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 Username Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
FWrite 1, 0, 1
FWrite 1, 0, 2
FWrite 1, Space(25), 25
INTEGER003 = 67
Goto LABEL027
:LABEL026
BOOLEAN003 = 1
FOpen 1, STRING002, 2, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
:LABEL027
If (BOOLEAN002) Goto LABEL028
If (BOOLEAN001) Then
FSeek 1, 39 + INTEGER001 * 28 - 28, 0
FRead 1, BOOLEAN006, 1
FRead 1, WORD001, 2
FRead 1, STRING003, 25
BOOLEAN001 = 0
Endif
PrintLn
INTEGER002 = (INTEGER003 - 39) / 28
PrintLn " @X0FName Trash File"
PrintLn " @X0BRecord #@X0E" + String(INTEGER001) + "@X0B of @X0E" + String(INTEGER002)
Print " @X0F(@X09D@X0F)eleted : @X0C"
If (BOOLEAN006) Then
PrintLn "Yes"
Else
PrintLn "No "
Endif
PrintLn
PrintLn " @X0FN(@X09O@X0F)de : @X0C" + String(WORD001)
PrintLn " @X0F(@X09N@X0F)ame : @X0C" + STRING003
PrintLn
PrintLn " @X0F(@X09+@X0F) @X0BAdvance 1 record @X0F(@X09-@X0F) @X0BRetard 1 record"
PrintLn " @X0F(@X09J@X0F)@X0Bump to record @X0F(@X09A@X0F)@X0Bdd a record"
PrintLn " @X0F(@X09Q@X0F)@X0Buit"
PrintLn
STRING004 = "+"
InputStr "Enter command", STRING004, 10, 1, "NnAaDdJj+-OoQqRr", 2 + 4
Newline
STRING004 = Upper(STRING004)
Select Case (STRING004)
Case "Q", "R"
FClose 1
BOOLEAN001 = 0
BOOLEAN002 = 1
Case "+"
If (INTEGER001 >= INTEGER002) Then
INTEGER001 = 1
Else
Inc INTEGER001
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "-"
If (INTEGER001 <= 1) Then
INTEGER001 = INTEGER002
Else
Dec INTEGER001
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "J"
INTEGER004 = INTEGER002
InputInt "Enter record # to jump to", INTEGER004, 10
If (INTEGER004 > INTEGER002) Then
INTEGER001 = INTEGER002
ElseIf (INTEGER004 < 1) Then
INTEGER001 = 1
Else
INTEGER001 = INTEGER004
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "D"
FSeek 1, 39 + INTEGER001 * 28 - 28, 0
If (BOOLEAN006) Then
FWrite 1, 0, 1
Else
FWrite 1, 1, 1
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "A"
FSeek 1, 0, 2
WORD001 = 0
InputInt "Enter node affected (0 = ALL)", WORD001, 12
STRING003 = ""
Newline
InputStr "Enter name", STRING003, 10, 25, Mask_Ascii(), 2 + 4
STRING003 = Upper(STRING003)
Newline
PrintLn "@X0FCreating record..."
FWrite 1, 0, 1
FWrite 1, WORD001, 2
FWrite 1, STRING003, 25
INTEGER002 = INTEGER002 + 1
INTEGER003 = INTEGER003 + 28
INTEGER001 = INTEGER002
BOOLEAN001 = 1
BOOLEAN002 = 0
Case "O"
InputInt "Enter new node affected (0 = ALL)", WORD001, 12
FSeek 1, 39 + INTEGER001 * 28 - 27, 0
FWrite 1, WORD001, 2
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "N"
InputStr "Enter new name", STRING003, 10, 25, Mask_Ascii(), 2 + 4
STRING003 = Upper(STRING003)
FSeek 1, 39 + INTEGER001 * 28 - 25, 0
FWrite 1, STRING003, 25
BOOLEAN002 = 0
BOOLEAN001 = 1
End Select
Goto LABEL027
:LABEL028
FClose 1
Return
:LABEL029
BOOLEAN002 = 0
BOOLEAN001 = 1
INTEGER001 = 1
Gosub LABEL033
FSeek 2, 959, 0
FRead 2, STRING002, 75
FClose 2
INTEGER003 = FileInf(STRING002, 4)
If (Exist(STRING002)) Goto LABEL030
PrintLn
PrintLn "@X0CCreating " + STRING002
BOOLEAN003 = 1
FCreate 1, STRING002, 2, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 Security Trash File" + Chr(13) + Chr(32) + Chr(10) + Chr(26) + Chr(0), 39
FWrite 1, 0, 1
FWrite 1, 0, 2
FWrite 1, 0, 1
INTEGER003 = 43
Goto LABEL031
:LABEL030
BOOLEAN003 = 1
FOpen 1, STRING002, 2, 2
If (Ferr(1)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
:LABEL031
If (BOOLEAN002) Goto LABEL032
If (BOOLEAN001) Then
FSeek 1, 39 + INTEGER001 * 4 - 4, 0
FRead 1, BOOLEAN006, 1
FRead 1, WORD001, 2
FRead 1, BYTE001, 1
BOOLEAN001 = 0
Endif
PrintLn
INTEGER002 = (INTEGER003 - 39) / 4
PrintLn " @X0FSecurity Trash File"
PrintLn " @X0BRecord #@X0E" + String(INTEGER001) + "@X0B of @X0E" + String(INTEGER002)
Print " @X0F(@X09D@X0F)eleted : @X0C"
If (BOOLEAN006) Then
PrintLn "Yes"
Else
PrintLn "No "
Endif
PrintLn
PrintLn " @X0FN(@X09O@X0F)de : @X0C" + String(WORD001)
PrintLn " @X0F(@X09S@X0F)ecurity Level : @X0C" + String(BYTE001)
PrintLn
PrintLn " @X0F(@X09+@X0F) @X0BAdvance 1 record @X0F(@X09-@X0F) @X0BRetard 1 record"
PrintLn " @X0F(@X09J@X0F)@X0Bump to record @X0F(@X09A@X0F)@X0Bdd a record"
PrintLn " @X0F(@X09Q@X0F)@X0Buit"
PrintLn
STRING004 = "+"
InputStr "Enter command", STRING004, 10, 1, "SsAaDdJj+-OoQqRr", 2 + 4
Newline
STRING004 = Upper(STRING004)
Select Case (STRING004)
Case "Q", "R"
FClose 1
BOOLEAN001 = 0
BOOLEAN002 = 1
Case "+"
If (INTEGER001 >= INTEGER002) Then
INTEGER001 = 1
Else
Inc INTEGER001
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "-"
If (INTEGER001 <= 1) Then
INTEGER001 = INTEGER002
Else
Dec INTEGER001
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "J"
INTEGER004 = INTEGER002
InputInt "Enter record # to jump to", INTEGER004, 10
If (INTEGER004 > INTEGER002) Then
INTEGER001 = INTEGER002
ElseIf (INTEGER004 < 1) Then
INTEGER001 = 1
Else
INTEGER001 = INTEGER004
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "D"
FSeek 1, 39 + INTEGER001 * 4 - 4, 0
If (BOOLEAN006) Then
FWrite 1, 0, 1
Else
FWrite 1, 1, 1
Endif
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "A"
FSeek 1, 0, 2
WORD001 = 0
InputInt "Enter node affected (0 = ALL)", WORD001, 12
BYTE001 = 0
Newline
InputInt "Enter security level", BYTE001, 10
Newline
PrintLn "@X0FCreating record..."
FWrite 1, 0, 1
FWrite 1, WORD001, 2
FWrite 1, BYTE001, 1
INTEGER002 = INTEGER002 + 1
INTEGER003 = INTEGER003 + 4
INTEGER001 = INTEGER002
BOOLEAN001 = 1
BOOLEAN002 = 0
Case "O"
InputInt "Enter new node affected (0 = ALL)", WORD001, 12
FSeek 1, 39 + INTEGER001 * 4 - 3, 0
FWrite 1, WORD001, 2
BOOLEAN002 = 0
BOOLEAN001 = 1
Case "S"
InputInt "Enter new security level", BYTE001, 10
FSeek 1, 39 + INTEGER001 * 4 - 1, 0
FWrite 1, BYTE001, 1
BOOLEAN002 = 0
BOOLEAN001 = 1
End Select
Goto LABEL031
:LABEL032
FClose 1
Return
:LABEL033
STRING001 = PPEPath() + "LBKBACK.XXX"
If (Exist(STRING001)) Then
FOpen 2, STRING001, 0, 0
Else
PrintLn
PrintLn "@X0FPath & filename to LoopBack config file @X0E(Enter Below)"
InputStr "", STRING001, 12, 75, Mask_Path() + Mask_File(), 2 + 4
If (Exist(STRING001)) Goto LABEL034
PrintLn
PrintLn "@X0C" + STRING001 + " DOES NOT EXIST! @X0AReturning to LoopUtil Main..."
Goto LABEL039
Goto LABEL035
:LABEL034
FOpen 2, STRING001, 0, 0
Endif
:LABEL035
If (Ferr(2)) Then
BOOLEAN003 = 1
Else
BOOLEAN003 = 0
Endif
If (BOOLEAN003) Then
PrintLn
PrintLn "@X0CSorry, the " + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 2
Return
Endif
Return
:LABEL036
If (INTEGER001 == 1) BYTE005 = 0
If ((INTEGER001 <> 0) && (INTEGER002 <> 0)) Then
REAL002 = ToReal(INTEGER001) / ToReal(INTEGER002)
REAL003 = FmtReal(ToReal(35) * REAL002, 1, 0)
BYTE004 = ToByte(REAL003) - BYTE005
If (BYTE004 <> BYTE005) Then
Color 63
AnsiPos 4 + BYTE005, BYTE002
For BYTE005 = 1 To BYTE004
Print "░"
Next
BYTE005 = ToByte(REAL003)
REAL002 = FmtReal(REAL002 * 100, 1, 0)
BYTE004 = (43 - Len(String(REAL002) + "%")) / 2
Color 11
REAL003 = ToReal(BYTE002) - 1
AnsiPos BYTE004, ToByte(REAL003)
Print String(REAL002) + "%"
AnsiPos 45, BYTE002
Endif
Endif
Return
:LABEL037
If ((INTEGER001 <> 0) && (INTEGER002 <> 0)) Then
If (INTEGER001 == 1) Then
BYTE003 = 0
Goto LABEL038
Endif
BYTE003 = REAL001
:LABEL038
REAL001 = ToReal(INTEGER001) / ToReal(INTEGER002)
REAL001 = FmtReal(REAL001 * 100, 1, 0)
If (BYTE003 <> REAL001) Then
Backup Len(String(BYTE003) + "%")
Print String(REAL001) + "%"
Endif
Endif
Return
:LABEL039
End
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 1 End
; 4 Cls
; 4 Color
; 221 Goto
; 216 Let
; 15 Print
; 187 PrintLn
; 134 If
; 10 FCreate
; 12 FOpen
; 2 FAppend
; 53 FClose
; 2 FGet
; 2 FPutLn
; 4 Delete
; 6 Log
; 10 InputStr
; 10 InputInt
; 22 Gosub
; 38 Return
; 10 Delay
; 8 Inc
; 2 Dec
; 11 Newline
; 1 GetToken
; 2 KbdChkOn
; 2 KbdChkOff
; 3 AnsiPos
; 3 Backup
; 4 Rename
; 30 FSeek
; 22 FRead
; 46 FWrite
;
;
; ■ Functions used :
;
; 13 *
; 13 /
; 191 +
; 23 -
; 32 ==
; 9 <>
; 5 <
; 9 <=
; 2 >
; 4 >=
; 143 !
; 16 &&
; 4 ||
; 4 Len(
; 13 Upper()
; 7 Space()
; 23 Ferr()
; 42 Chr()
; 8 Trim()
; 2 Strip()
; 34 String()
; 5 Mask_File()
; 5 Mask_Path()
; 2 Mask_Ascii()
; 13 PPEPath()
; 12 PcbNode()
; 4 OnLocal()
; 14 Exist()
; 1 S2I()
; 2 GetY()
; 10 FileInf()
; 1 TokCount()
; 3 ToByte()
; 6 ToReal()
; 3 FmtReal()
;
;------------------------------------------------------------------------------
;
; Analysis flags : No flag
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 1 For/Next
; 4 While/EndWhile
; 83 If/Then or If/Then/Else
; 4 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------